---
title: "Deceptive Communication: Data Analysis Replication Script"
author: "Despoina Alempaki, Valeria Burdea, Daniel Read"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output: 
  bookdown::html_document2: 
    number_sections: yes
    toc : true
    toc_float : true
editor_options: 
  chunk_output_type: console
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning=FALSE)

# Loading packages

if (!require("pacman")) install.packages("pacman")
pacman::p_load(scales, plyr, foreign, reshape2, 
               ggplot2, car, reshape2, dplyr, knitr,
               plm, psych, reshape, stargazer, gdata,
               plotrix, ggmap, lsmeans, gplots, tseries,
               lme4, Hmisc, jtools, haven, pander, nlme,
               summarytools, arsenal, rcompanion, ggsignif,
               gmodels, mfx, xtable, flextable, effectsize, margins,
               nFactors, patchwork, marginaleffects, paramhetero, stats,
               extrafont
)

loadfonts(device = "win")
   
rm(list=ls())

# Getting the path of the current open file
current_path = rstudioapi::getActiveDocumentContext()$path 
setwd(dirname(current_path ))


```


```{r load data, results='hide', warning=FALSE, message=FALSE}
# Load data
load(file = "Data-Evasion-S1.RData")
load(file = "Data-Evasion-S2.RData")
load(file = "Data-Evasion-S3.RData")


# set "control" condition (after treatments pooled) as the reference level:

df_S1$treat_pool<-as.factor(df_S1$treat_pool)
df_S2$treat_pool<-as.factor(df_S2$treat_pool)
df_S3$treat_pool<-as.factor(df_S3$treat_pool)

df_S1$treat_pool = factor(df_S1$treat_pool,levels(df_S1$treat_pool)[c(1,3,2,4)])
df_S2$treat_pool = factor(df_S2$treat_pool,levels(df_S2$treat_pool)[c(1,3,2,4)])
df_S3$treat_pool = factor(df_S3$treat_pool,levels(df_S3$treat_pool)[c(1,3,2,4)])

# set "medium or low" education level as the reference level

df_S1$educ_recode<-relevel(as.factor(df_S1$educ_recode), ref="medium_low")
df_S2$educ_recode<-relevel(as.factor(df_S2$educ_recode), ref="medium_low")
df_S3$educ_recode<-relevel(as.factor(df_S3$educ_recode), ref="medium_low")


# create data frame with both Study 1 and Study 2

df_all<-rbind(df_S1, df_S2[, names(df_S1)])%>%
  dplyr::select(-Control_q1:-errors_q5)


# create vectors to store p-values for multiple comparison adjustment

p_main_S1 <- rep(1, 3)
p_main_S2 <- rep(1, 3)
p_main_S3 <- rep(1, 3)
p_main_S3_ev <- rep(1, 3)



```


# STUDY 1

## Sample characteristics
Average demographics:

```{r warning=FALSE, message=FALSE}
df_S1%>%
  mutate(educ_high=ifelse(educ_recode=="high",1,0))%>%
  dplyr::summarise(n=n(),
            mean_age=mean(age_clean, na.rm=T),
            sd_age = sd(age_clean, na.rm=T), 
            se_age = sd_age/sqrt(n),
            female_freq=mean(female, na.rm=T),
            sd_female = sd(female, na.rm=T), 
            se_female = sd_female/sqrt(n),
            mean_high_educ=mean(educ_high, na.rm=T),
            sd_high_educ = sd(educ_high, na.rm=T), 
            se_high_educ = sd_high_educ/sqrt(n))

```

Average demographics across conditions (Table B19):

```{r warning=FALSE, message=FALSE}
df_S1%>%
  mutate(educ_high=ifelse(educ_recode=="high",1,0))%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::summarise(n=n(),
            mean_age=mean(age_clean, na.rm=T),
            sd_age = sd(age_clean, na.rm=T), 
            se_age = sd_age/sqrt(n),
            female_freq=mean(female, na.rm=T),
            sd_female = sd(female, na.rm=T), 
            se_female = sd_female/sqrt(n),
            mean_high_educ=mean(educ_high, na.rm=T),
            sd_high_educ = sd(educ_high, na.rm=T), 
            se_high_educ = sd_high_educ/sqrt(n))

```

* Is the average age different across conditions? - NO:

```{r warning=FALSE, message=FALSE}


# testing using Kruskal-Wallis

kruskal.test(age_clean ~ treat_pool, data = df_S1)


```

* Is the gender distribution different across conditions? - NO

```{r warning=FALSE, message=FALSE}


tbl<-table(df_S1$treat_pool, df_S1$female)
chisq.test(tbl) 

```

* Is the education level different across conditions? - NO:

```{r warning=FALSE, message=FALSE}

tbl<-table(df_S1$treat_pool, df_S1$educ_high)
chisq.test(tbl) 


```

## Preliminaries

Checking that the decision to lie is not different across the baseline conditions:

```{r warning=FALSE, message=FALSE}

tbl<-table(subset(df_S1,treat_pool=="control")$treat, subset(df_S1,treat_pool=="control")$decision_code)
chisq.test(tbl) 

```

Results of Chi-square test suggest they are not, which means we can safely pool across these.

## Deception across conditions

### Is evasive lying less costly than direct-lying? (Chi-square tests)


* Chi-square test of baseline (direct-lie) vs. "Ignorance" treatment:

```{r }
temp<-subset(df_S1, treat_pool=="control"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 

#store p-value
p_main_S1[1]<-chisq.test(tbl, correct=FALSE)$p.value

```

* Chi-square test of baseline (direct-lie) vs. "Selective" treatment:

```{r}

temp<-subset(df_S1, treat_pool=="control"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 

#store p-value
p_main_S1[2]<-chisq.test(tbl, correct=FALSE)$p.value

```

* Chi-square test of baseline (direct-lie) vs. "Silence" treatment:

```{r}

temp<-subset(df_S1, treat_pool=="control"|treat=="t_s")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 

#store p-value
p_main_S1[3]<-chisq.test(tbl, correct=FALSE)$p.value

```


* multiple comparison adjustment:

```{r FDR}
p_main_S1
p.adjust(p_main_S1, method = 'fdr', n = length(p_main_S1))


```

* Chi-square test of baseline (direct-lie) vs. all evasion treatments:

```{r }
tbl<-table(df_S1$treat_pool_bin, df_S1$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 

# effect size

cohens_d(lie ~ treat_pool_bin, data = df_S1, var.equal = TRUE) 

```

## Compute effect sizes

* direct vs. ignorance

```{r }

# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ treat_pool, data = subset(df_S1, treat_pool=="control"|treat=="t_idk"))
res.ftest

temp<- subset(df_S1, treat_pool=="control"|treat=="t_idk")

# Effect size
cohens_d(lie ~ treat_pool, data = temp, var.equal = TRUE)

```

* direct vs. selective

```{r }

# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ treat_pool, data = subset(df_S1, treat_pool=="control"|treat=="t_ht"))
res.ftest

temp<- subset(df_S1, treat_pool=="control"|treat=="t_ht")

# Effect size
cohens_d(lie ~ treat_pool, data = temp, var.equal = TRUE)

```

* direct vs. silence

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ treat_pool, data = subset(df_S1, treat_pool=="control"|treat=="t_s"))
res.ftest

temp<- subset(df_S1, treat_pool=="control"|treat=="t_s")

# Effect size
cohens_d(lie ~ treat_pool, data = temp, var.equal = TRUE)


```


### Plot (Figure 3)

```{r}
ds<-df_S1 %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_lying = mean(lie), n = n(), 
            sd = sd(lie), se = sd/sqrt(n))



ggplot(ds, aes(x=avg_lying,y=treat_pool)) +
  geom_point(size=3)+ 
  geom_errorbarh(aes(xmin=avg_lying-se, xmax=avg_lying+se), height=.1, size=1)+
  theme_bw()+ 
  #scale_color_grey() +
  geom_text(aes(label=round(avg_lying, digits=2)), vjust=-1, size=6) +
  scale_y_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+
  theme(text=element_text( family="serif"),
        legend.position = "none", 
        axis.text=element_text(size=14,face="bold"), axis.title=element_text(size=16,face="bold"), 
        plot.title=element_text(size=18,face="bold", hjust=0.5))+
  labs(y=c("Treatment\n"), x=c("\nDeception rate"))+
  xlim(0.25, 0.75) + 
  geom_segment(aes(x = 0.4, y = 1, xend = 0.4, yend = 2), color="black", size=0.5)+
  geom_segment(aes(x = 0.35, y = 1, xend = 0.35, yend = 3), color="black", size=0.5)+
  geom_segment(aes(x = 0.3, y = 1, xend = 0.3, yend = 4), color="black", size=0.5) +
  annotate(geom = "text", x = 0.385, y = 1.5, label = "ns", color = "black", angle = 90, size=6)+
  annotate(geom = "text", x = 0.335, y = 2, label = "*", color = "black", angle = 90, size=6)+
  annotate(geom = "text", x = 0.285, y = 2.5, label = "*", color = "black", angle = 90, size=6)

ggsave("Figure3.pdf",width=20, height=15, units="cm")


```

### Probit regressions (Table 3 and robustness checks)

```{r}

# direct vs all evasions individually (Table 3, column 1)


probit_S1_ctrl <- glm(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=df_S1, family=binomial(link="probit"))

probit_S1_ctrl_mfx <- probitmfx(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=df_S1)
probit_S1_ctrl_mfx

# fdr adjusted p-values

p.probit_S1_ctrl_mfx<-parameters::p_value(probit_S1_ctrl_mfx)$p
p.probit_S1_ctrl_mfx.adjusted<-stats::p.adjust(p.probit_S1_ctrl_mfx, method="fdr")
p.probit_S1_ctrl_mfx.adjusted

# direct vs all evasions pooled (Table 3, column 2)


probit_S1_pooled_b <- glm(lie ~ treat_pool_bin + b_red_after_X +b_red_after_BLUE +b_liars+ female +age_clean + educ_high, data=df_S1, family=binomial(link="probit"))

probit_S1_pooled_b_mfx <- probitmfx(lie ~ treat_pool_bin + b_red_after_X +b_red_after_BLUE +b_liars+ female +age_clean + educ_high, data=df_S1)
probit_S1_pooled_b_mfx

# fdr adjusted p-values
p.probit_S1_pooled_b_mfx<-parameters::p_value(probit_S1_pooled_b_mfx)$p
p.probit_S1_pooled_b_mfx.adjusted<-stats::p.adjust(p.probit_S1_pooled_b_mfx, method="fdr")
p.probit_S1_pooled_b_mfx.adjusted


# test for differences in the coefficients in Table 3, column 1, of the evasion treatments 

# Ignorance vs Selective

linearHypothesis(probit_S1_ctrl,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

# Ignorance vs Silence

linearHypothesis(probit_S1_ctrl, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

# Selective vs Silence

linearHypothesis(probit_S1_ctrl, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)



# regressions without controlling for any beliefs

## Appendix, Table B27, Column 1

probit_S1_ctrl_no_b_mfx <- probitmfx(lie ~ treat_pool + female +age_clean + educ_high, data=df_S1)

probit_S1_ctrl_no_b_mfx

## Appendix, Table B27, Column 2

probit_S1_bin_ctrl_no_b_mfx <- probitmfx(lie ~ treat_pool_bin + female +age_clean + educ_high, data=df_S1)

probit_S1_bin_ctrl_no_b_mfx


# regressions without controlling for belief that others deceive or for gender

## Appendix, Table B30, Column 1

probit_S1_ctrl_wout_Bliars_mfx <- probitmfx(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S1)

probit_S1_ctrl_wout_Bliars_mfx


### linear hypothesis tests for comparison of coefficients in Table B30, Column 1

probit_S1_ctrl_wout_Bliars <- glm(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S1, family=binomial(link="probit"))

#### Ignorance vs Selective

linearHypothesis(probit_S1_ctrl_wout_Bliars,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Ignorance vs Silence

linearHypothesis(probit_S1_ctrl_wout_Bliars, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Selective vs Silence

linearHypothesis(probit_S1_ctrl_wout_Bliars, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

## Appendix, Table B30, Column 2

probit_S1_ctrl_wout_female_mfx <- probitmfx(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + b_liars +age_clean + educ_high, data=df_S1)

probit_S1_ctrl_wout_female_mfx


### linear hypothesis tests for comparison of coefficients in Table B30, Column 2

probit_S1_ctrl_wout_female <- glm(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + b_liars +age_clean + educ_high, data=df_S1, family=binomial(link="probit"))

#### Ignorance vs Selective

linearHypothesis(probit_S1_ctrl_wout_female,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Ignorance vs Silence

linearHypothesis(probit_S1_ctrl_wout_female, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Selective vs Selective

linearHypothesis(probit_S1_ctrl_wout_female, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"),  
                 white.adjust=TRUE)


# interaction with belief that others deceive (Appendix, Table B32)

probit_S1_ctrl_interact_b_liars_mfx <- probitmfx(lie ~ treat_pool*b_liars + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S1)

probit_S1_ctrl_interact_b_liars_mfx


### linear hypothesis tests for comparison of coefficients in Table B32

probit_S1_ctrl_interact_b_liars <- glm(lie ~ treat_pool*b_liars + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S1, family=binomial(link="probit"))

#### Ignorance vs Selective

linearHypothesis(probit_S1_ctrl_interact_b_liars,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Ignorance vs Silence

linearHypothesis(probit_S1_ctrl_interact_b_liars, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Selective vs Silence

linearHypothesis(probit_S1_ctrl_interact_b_liars, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"),  
                 white.adjust=TRUE)


```

### Chi-square tests for comparing across the evasive treatments

* Chi-square test of "Ignorance" vs. "Selective":

```{r }
temp<-subset(df_S1, treat=="t_ht"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 
```

* Chi-square test of "Ignorance" vs. "Silence":

```{r }
temp<-subset(df_S1, treat=="t_s"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 
```

* Chi-square test of "Selective" vs. "Silence":

```{r }
temp<-subset(df_S1, treat=="t_s"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 
```

## Beliefs analysis

### Average beliefs by treatment

* Figure 4:

```{r}
df_S1%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::summarise(mean_b_red_after_nonBLUE=mean(b_red_after_X, na.rm=T),
            mean_b_red_afterBLUE=mean(b_red_after_BLUE, na.rm=T),
            mean_b_liars=mean(b_liars, na.rm=T),
            corr_first_second_b=cor(b_red_after_X, b_red_after_BLUE))

temp<-df_S1%>%
  dplyr::select(treat_pool, b_red_after_X, b_red_after_BLUE, b_liars, sub_id)%>%
  reshape(direction='long', 
          varying=list(c('b_red_after_X','b_red_after_BLUE', 'b_liars')), 
          timevar='belief_type',
          times=c('red_after_nonBLUE', 'red_after_BLUE', 'liar_freq'),
          v.names=c('belief'),
          idvar='sub_id')%>%
  dplyr::group_by(belief_type, treat_pool)%>%
  dplyr::summarise(average_belief=mean(belief,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief,na.rm=T)/sqrt(n-1))

temp$belief_type<-as.factor(temp$belief_type)

temp$belief_type = factor(temp$belief_type,levels(temp$belief_type)[c(3,2,1)])


temp%>%
  ggplot(aes(x=belief_type,y=average_belief,fill=treat_pool))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_belief-ci,ymax = average_belief+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=4,label=paste0(round(average_belief,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=5)+
  labs(x="\nBelief Type", y="Average Sender Beliefs", fill="Treatment")+
  theme_bw()+
  scale_x_discrete(labels=c("B(a=Red|m=non-Blue)", "B(a=Red|m=Blue)", "B(others-deceive)" ))+
  scale_y_continuous(limits = c(0,100), labels=function(x) paste0(x, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14,  family="serif"))+ 
  scale_fill_grey(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE")) 

ggsave("Figure4.pdf",width=20, height=15, units="cm")

```

* Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE different across conditions? (Direct lying: nonBLUE=RED; Selective: nonBLUE="The segment was more likely to be RED than BLUE"; Ignorance: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

kruskal.test(b_red_after_X ~ treat_pool, data = df_S1)

```



* belief distribution by treatment and decision (Appendix, Figure B1)

```{r}
df_S1%>%
  dplyr::group_by(treat_pool, decision_code)%>%
  dplyr::summarise(mean_b_red_after_nonBLUE=mean(b_red_after_X, na.rm=T),
            mean_b_red_afterBLUE=mean(b_red_after_BLUE, na.rm=T),
            mean_b_liars=mean(b_liars, na.rm=T))

sender_names <- as_labeller(c(
  'lie'="Deceptive",
  'truth'="Truth"
))


df_S1%>%
  dplyr::select(treat_pool, decision_code, b_red_after_X, b_red_after_BLUE, b_liars, sub_id)%>%
  reshape(direction='long', 
          varying=list(c('b_red_after_X','b_red_after_BLUE', 'b_liars')), 
          timevar='belief_type',
          times=c('red_after_nonBLUE', 'red_after_BLUE', 'liar_freq'),
          v.names=c('belief'),
          idvar='sub_id')%>%
  dplyr::group_by(belief_type, treat_pool, decision_code)%>%
  dplyr::summarise(average_belief=mean(belief,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief,na.rm=T)/sqrt(n-1))%>%
  ggplot(aes(x=belief_type,y=average_belief,fill=treat_pool))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_belief-ci,ymax = average_belief+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=4,label=paste0(round(average_belief,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=4.4)+
  labs(x="\nBelief Type", y="Average Sender Beliefs", fill="Treatment")+
  theme_bw()+
  scale_x_discrete(labels=c("B(others-deceive)", "B(a=Red|m=Blue)", "B(a=Red|m=non-Blue)"))+
  scale_y_continuous(limits = c(0,100), labels=function(x) paste0(x, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14))+   scale_fill_grey(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE")) +
  facet_wrap(~decision_code, labeller=sender_names)

ggsave("FigureB1.png",width=30, height=15, units="cm")

```

* (Appendix, Table B9) Are beliefs about the likelihood of receivers choosing RED after the message is BLUE different across sender decisions?

```{r warning=FALSE, message=FALSE}

anova.b2 <- aov(b_red_after_BLUE ~ treat_pool*decision_code, data = df_S1)
summary(anova.b2)


```

* (Appendix, Table B10) Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE different across sender decision? (Direct lying: nonBLUE=RED; Selective: nonBLUE="The segment was more likely to be RED than BLUE"; Ignorance: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

anova.b3 <- aov(b_red_after_X ~ treat_pool*decision_code, data = df_S1)
summary(anova.b3)


```

* (Appendix, Table B11) Are beliefs about the frequency of liars different across sender decision?


```{r warning=FALSE, message=FALSE}

anova.b1 <- aov(b_liars ~ treat_pool*decision_code, data = df_S1)
summary(anova.b1)


```


* Are beliefs about the likelihood of receivers choosing RED after the message is BLUE different across treatments?

```{r warning=FALSE, message=FALSE}

kruskal.test(b_red_after_BLUE ~ treat_pool, data = df_S1)

# Appendix, Table B1

anova.b2 <- aov(b_red_after_BLUE ~ treat_pool, data = df_S1)
summary(anova.b2)
TukeyHSD(anova.b2)

```


* Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE different across treatments? (Direct lying: nonBLUE=RED; Half-truth: nonBLUE="The segment was more likely to be RED than BLUE"; I don't know: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

kruskal.test(b_red_after_X ~ treat_pool, data = df_S1)

# Appendix, Table B2

anova.b3 <- aov(b_red_after_X ~ treat_pool, data = df_S1)
summary(anova.b3)
TukeyHSD(anova.b3)

```


* Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE higher than after the message is truthful (BLUE)? (Direct lying: nonBLUE=RED; Selective: nonBLUE="The segment was more likely to be RED than BLUE"; Ignorance: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

# DIRECT

t.test(subset(df_S1, treat_pool=="control")$b_red_after_X, subset(df_S1, treat_pool=="control")$b_red_after_BLUE, paired = TRUE)

# IGNORANCE

t.test(subset(df_S1, treat_pool=="t_idk")$b_red_after_X, subset(df_S1, treat_pool=="t_idk")$b_red_after_BLUE, paired = TRUE)

# SELECTIVE

t.test(subset(df_S1, treat_pool=="t_ht")$b_red_after_X, subset(df_S1, treat_pool=="t_ht")$b_red_after_BLUE, paired = TRUE)

# SILENCE

t.test(subset(df_S1, treat_pool=="t_s")$b_red_after_X, subset(df_S1, treat_pool=="t_s")$b_red_after_BLUE, paired = TRUE)

```


* Are beliefs about the frequency of liars different across conditions?

```{r warning=FALSE, message=FALSE}

kruskal.test(b_liars ~ treat_pool, data = df_S1)

# Appendix, Table B3

anova.b1 <- aov(b_liars ~ treat_pool, data = df_S1)
summary(anova.b1)
TukeyHSD(anova.b1)


```



# STUDY 2

## Sample characteristics

Average demographics:

```{r warning=FALSE, message=FALSE}
df_S2%>%
  mutate(educ_high=ifelse(educ_recode=="high",1,0))%>%
  dplyr::summarise(n=n(),
            mean_age=mean(age_clean, na.rm=T),
            sd_age = sd(age_clean, na.rm=T), 
            se_age = sd_age/sqrt(n),
            female_freq=mean(female, na.rm=T),
            sd_female = sd(female, na.rm=T), 
            se_female = sd_female/sqrt(n),
            mean_high_educ=mean(educ_high, na.rm=T),
            sd_high_educ = sd(educ_high, na.rm=T), 
            se_high_educ = sd_high_educ/sqrt(n))

```

Average demographics across conditions (Table B20):

```{r warning=FALSE, message=FALSE}
df_S2%>%
  mutate(educ_high=ifelse(educ_recode=="high",1,0))%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::summarise(n=n(),
            mean_age=mean(age_clean, na.rm=T),
            sd_age = sd(age_clean, na.rm=T), 
            se_age = sd_age/sqrt(n),
            female_freq=mean(female, na.rm=T),
            sd_female = sd(female, na.rm=T), 
            se_female = sd_female/sqrt(n),
            mean_high_educ=mean(educ_high, na.rm=T),
            sd_high_educ = sd(educ_high, na.rm=T), 
            se_high_educ = sd_high_educ/sqrt(n))

```

* Is the average age different across conditions? - NO:

```{r warning=FALSE, message=FALSE}

# testing using Kruskal-Wallis

kruskal.test(age_clean ~ treat_pool, data = df_S2)


```

* Is the gender distribution different across conditions? - NO

```{r warning=FALSE, message=FALSE}

tbl<-table(df_S2$treat_pool, df_S2$female)
chisq.test(tbl) 


```

* Is the education level different across conditions? - NO:

```{r warning=FALSE, message=FALSE}

tbl<-table(df_S2$treat_pool, df_S2$educ_high)
chisq.test(tbl) 

```

## Preliminaries

Checking that the decision to lie is not different across the baseline conditions:

```{r warning=FALSE, message=FALSE}

tbl<-table(subset(df_S2,treat_pool=="control")$treat, subset(df_S2,treat_pool=="control")$decision_code)
chisq.test(tbl) 

```

## Deception across conditions

### Is evasive lying less costly than direct-lying? (Chi-square tests)


* Chi-square test of baseline (direct-lie) vs. "Ignorance" treatment:

```{r }
temp<-subset(df_S2, treat_pool=="control"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S2[1]<-chisq.test(tbl, correct=FALSE)$p.value

```

* Chi-square test of baseline (direct-lie) vs. "Selective" treatment:

```{r}

temp<-subset(df_S2, treat_pool=="control"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S2[2]<-chisq.test(tbl, correct=FALSE)$p.value

```

* Chi-square test of baseline (direct-lie) vs. "Silence" treatment:

```{r}

temp<-subset(df_S2, treat_pool=="control"|treat=="t_s")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S2[3]<-chisq.test(tbl, correct=FALSE)$p.value

```


* multiple comparison adjustment:

```{r FDR }

p_main_S2
p.adjust(p_main_S2, method = 'fdr', n = length(p_main_S2))


```

## Compute effect sizes

* direct vs. ignorance

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ treat_pool, data = subset(df_S2, treat_pool=="control"|treat=="t_idk"))
res.ftest

temp<- subset(df_S2, treat_pool=="control"|treat=="t_idk")

# Effect size
cohens_d(lie ~ treat_pool, data = temp, var.equal = TRUE)

```

* direct vs. selective

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ treat_pool, data = subset(df_S2, treat_pool=="control"|treat=="t_ht"))
res.ftest

temp<- subset(df_S2, treat_pool=="control"|treat=="t_ht")

# Effect size
cohens_d(lie ~ treat_pool, data = temp, var.equal = TRUE)

```

* direct vs. silence

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ treat_pool, data = subset(df_S2, treat_pool=="control"|treat=="t_s"))
res.ftest

temp<- subset(df_S2, treat_pool=="control"|treat=="t_s")

# Effect size
cohens_d(lie ~ treat_pool, data = temp, var.equal = TRUE)


```

* Chi-square test of baseline (direct-lie) vs. all evasion treatments:

```{r }
tbl<-table(df_S2$treat_pool_bin, df_S2$decision_code)
tbl
chisq.test(tbl, correct=FALSE) 

# effect size

cohens_d(lie ~ treat_pool_bin, data = df_S2, var.equal = TRUE) 
```


### Plot (Figure 5)

```{r}
ds<-df_S2 %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_lying = mean(lie), n = n(), 
            sd = sd(lie), se = sd/sqrt(n))

ggplot(ds, aes(x=avg_lying,y=treat_pool)) +
  geom_point(size=3)+ 
  geom_errorbarh(aes(xmin=avg_lying-se, xmax=avg_lying+se), height=.1, size=1)+
  theme_bw()+ 
  #scale_color_grey() +
  geom_text(aes(label=round(avg_lying, digits=2)), vjust=-1, size=6) +
  scale_y_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+
  theme(text=element_text( family="serif"),
        legend.position = "none", 
        axis.text=element_text(size=14,face="bold"), axis.title=element_text(size=16,face="bold"), 
        plot.title=element_text(size=18,face="bold", hjust=0.5))+
 labs(y=c("Treatment\n"), x=c("\nDeception rate"))+
  xlim(0.23, 0.75) + 
  geom_segment(aes(x = 0.37, y = 1, xend = 0.37, yend = 2), color="black", size=0.5)+
  geom_segment(aes(x = 0.31, y = 1, xend = 0.31, yend = 3), color="black", size=0.5)+
  geom_segment(aes(x = 0.25, y = 1, xend = 0.25, yend = 4), color="black", size=0.5) +
  annotate(geom = "text", x = 0.35, y = 1.5, label = "ns", color = "black", angle = 90, size=6)+
  annotate(geom = "text", x = 0.29, y = 2, label = "*", color = "black", angle = 90, size=6)+
  annotate(geom = "text", x = 0.23, y = 2.5, label = "ns", color = "black", angle = 90, size=6)

ggsave("Figure5.pdf",width=20, height=15, units="cm")


```

### Probit regression (Table 4 and robustness checks)

```{r}

# direct vs all evasions individually (Table 4, Column 1)

probit_S2_ctrl <- glm(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=df_S2, family=binomial(link="probit"))

probit_S2_ctrl_mfx <- probitmfx(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=df_S2)
probit_S2_ctrl_mfx

# fdr adjusted p-values

p.probit_S2_ctrl_mfx<-parameters::p_value(probit_S2_ctrl_mfx)$p
p.probit_S2_ctrl_mfx.adjusted<-stats::p.adjust(p.probit_S2_ctrl_mfx, method="fdr")
p.probit_S2_ctrl_mfx.adjusted

# direct vs all evasions pooled (Table 4, Column 2)

probit_S2_pooled_b <- glm(lie ~ treat_pool_bin + b_red_after_X +b_red_after_BLUE +b_liars+ female +age_clean + educ_high, data=df_S2, family=binomial(link="probit"))

probit_S2_pooled_b_mfx <- probitmfx(lie ~ treat_pool_bin + b_red_after_X +b_red_after_BLUE +b_liars+ female +age_clean + educ_high, data=df_S2)
probit_S2_pooled_b_mfx

# fdr adjusted p-values

p.probit_S2_pooled_b_mfx<-parameters::p_value(probit_S2_pooled_b_mfx)$p
p.probit_S2_pooled_b_mfx.adjusted<-stats::p.adjust(p.probit_S2_pooled_b_mfx, method="fdr")
p.probit_S2_pooled_b_mfx.adjusted

# test for differences in the coefficients of the evasion treatments

## Ignorance vs Selective

linearHypothesis(probit_S2_ctrl,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

## Ignorance vs Silence

linearHypothesis(probit_S2_ctrl, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

## Selective vs Silence

linearHypothesis(probit_S2_ctrl, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)


# regressions without controlling for any beliefs

## Appendix, Table B28, Column 1

probit_S2_ctrl_no_b_mfx <- probitmfx(lie ~ treat_pool + female +age_clean + educ_high, data=df_S2)

probit_S2_ctrl_no_b_mfx

## Appendix, Table B28, Column 2

probit_S2_bin_ctrl_no_b_mfx <- probitmfx(lie ~ treat_pool_bin + female +age_clean + educ_high, data=df_S2)

probit_S2_bin_ctrl_no_b_mfx


# regressions without controlling for belief that others deceive or for gender

## Appendix, Table B31, Column 1

probit_S2_ctrl_wout_Bliars_mfx <- probitmfx(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S2)

probit_S2_ctrl_wout_Bliars_mfx

### linear hypothesis tests for comparison of coefficients in Table B31, Column 1

probit_S2_ctrl_wout_Bliars <- glm(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S2, family=binomial(link="probit"))

#### Ignorance vs Selective

linearHypothesis(probit_S2_ctrl_wout_Bliars,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Ignorance vs Silence

linearHypothesis(probit_S2_ctrl_wout_Bliars, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Selective vs Silence

linearHypothesis(probit_S2_ctrl_wout_Bliars, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)


## Appendix, Table B31, Column 2


probit_S2_ctrl_wout_female_mfx <- probitmfx(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + b_liars +age_clean + educ_high, data=df_S2)

probit_S2_ctrl_wout_female_mfx


### linear hypothesis tests for comparison of coefficients in Table B31, Column 2

probit_S2_ctrl_wout_female <- glm(lie ~ treat_pool + b_red_after_X +b_red_after_BLUE + b_liars +age_clean + educ_high, data=df_S2, family=binomial(link="probit"))

#### Ignorance vs Selective

linearHypothesis(probit_S2_ctrl_wout_female,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Ignorance vs Silence

linearHypothesis(probit_S2_ctrl_wout_female, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Selective vs Silence

linearHypothesis(probit_S2_ctrl_wout_female, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"),  
                 white.adjust=TRUE)



# interaction with belief that others deceive (Appendix, Table B33)

probit_S2_ctrl_interact_b_liars_mfx <- probitmfx(lie ~ treat_pool*b_liars + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S2)

probit_S2_ctrl_interact_b_liars_mfx


### linear hypothesis tests for comparison of coefficients in Table B33

probit_S2_ctrl_interact_b_liars <- glm(lie ~ treat_pool*b_liars + b_red_after_X +b_red_after_BLUE + female +age_clean + educ_high, data=df_S2, family=binomial(link="probit"))

#### Ignorance vs Selective

linearHypothesis(probit_S2_ctrl_interact_b_liars,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Ignorance vs Silence

linearHypothesis(probit_S2_ctrl_interact_b_liars, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

#### Selective vs Silence

linearHypothesis(probit_S2_ctrl_interact_b_liars, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"),  
                 white.adjust=TRUE)


```

### Chi-square tests for comparing across the evasive treatments

* Chi-square test of "Ignorance" vs. "Selective":

```{r }
temp<-subset(df_S2, treat=="t_ht"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 
```

* Chi-square test of "Ignorance" vs. "Silence":

```{r }
temp<-subset(df_S2, treat=="t_s"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 
```

* Chi-square test of "Selective" vs. "Silence":

```{r }
temp<-subset(df_S2, treat=="t_s"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 
```

# Comparing deception rates across Study 1 and Study 2

## Preliminaries

* Is the average age different across experiment? - NO:

```{r warning=FALSE, message=FALSE}

# testing using Kruskal-Wallis

kruskal.test(age_clean ~ experiment, data = df_all)



```

* Is the gender distribution different across experiments? - NO

```{r warning=FALSE, message=FALSE}

tbl<-table(df_all$experiment, df_all$female)
chisq.test(tbl, correct = FALSE) 

```

* Is the education level different across experiments? - NO:

```{r warning=FALSE, message=FALSE}

tbl<-table(df_all$experiment, df_all$educ_high)
chisq.test(tbl, correct = FALSE) 

```

## Pairwise Chi-square tests

* Chi-square test of baseline in S1 vs. S2:

```{r }
temp<-subset(df_all, treat_pool=="control")
temp <- droplevels(temp)

tbl<-table(temp$experiment, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

```

* Chi-square test of "Ignorance" in S1 vs. S2:

```{r }
temp<-subset(df_all, treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$experiment, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

```

* Chi-square test of "Selective" in S1 vs. S2:

```{r}

temp<-subset(df_all, treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$experiment, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

```

* Chi-square test of "Silence" in S1 vs. S2:

```{r}

temp<-subset(df_all, treat=="t_s")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$experiment, temp$decision_code)
tbl
chisq.test(tbl, correct = FALSE) 

```

## Compute effect sizes

* baseline in S1 vs S2

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ experiment, data = subset(df_all, treat_pool=="control"))
res.ftest

temp<- subset(df_all, treat_pool=="control")

# Effect size
cohens_d(lie ~ experiment, data = temp, var.equal = TRUE)

```

* Ignorance in S1 vs S2

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ experiment, data = subset(df_all, treat=="t_idk"))
res.ftest

temp<- subset(df_all, treat=="t_idk")

# Effect size
cohens_d(lie ~ experiment, data = temp, var.equal = TRUE)

```

* Selective in S1 vs S2

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ experiment, data = subset(df_all, treat=="t_ht"))
res.ftest

temp<- subset(df_all, treat=="t_ht")

# Effect size
cohens_d(lie ~ experiment, data = temp, var.equal = TRUE)


```

* Silence in S1 vs S2

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(lie ~ experiment, data = subset(df_all, treat=="t_s"))
res.ftest

temp<- subset(df_all, treat=="t_s")

# Effect size
cohens_d(lie ~ experiment, data = temp, var.equal = TRUE)


```

## Regression analysis (Appendix, Table B18)

```{r}

# Table B18, Column (Overall)


logit_all_S1vS2 <- glm(lie ~ experiment + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high + treat_pool, data=df_all, family=binomial(link="logit"))

margins_summary(logit_all_S1vS2)


# Table B18, Column  (DIRECT)

probit_direct_S1vS2_mfx <- probitmfx(lie ~ experiment + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=subset(df_all, treat_pool=="control"))

probit_direct_S1vS2_mfx


# Table B18, Column  (IGNORANCE)


probit_idk_S1vS2_mfx <- probitmfx(lie ~ experiment + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=subset(df_all, treat=="t_idk"))

probit_idk_S1vS2_mfx


# Table B18, Column  (SELECTIVE)


probit_ht_S1vS2_mfx <- probitmfx(lie ~ experiment + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=subset(df_all, treat=="t_ht"))

probit_ht_S1vS2_mfx

# Table B18, Column  (SILENCE)


probit_s_S1vS2_mfx <- probitmfx(lie ~ experiment + b_red_after_X +b_red_after_BLUE +b_liars + female +age_clean + educ_high, data=subset(df_all, treat=="t_s"))

probit_s_S1vS2_mfx


```


## Beliefs analysis

### Average beliefs by treatment

* Figure 6

```{r}
df_S2%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::summarise(mean_b_red_after_nonBLUE=mean(b_red_after_X, na.rm=T),
            mean_b_red_afterBLUE=mean(b_red_after_BLUE, na.rm=T),
            mean_b_liars=mean(b_liars, na.rm=T))

temp<-df_S2%>%
  dplyr::select(treat_pool, b_red_after_X, b_red_after_BLUE, b_liars, sub_id)%>%
  reshape(direction='long', 
          varying=list(c('b_red_after_X','b_red_after_BLUE', 'b_liars')), 
          timevar='belief_type',
          times=c('red_after_nonBLUE', 'red_after_BLUE', 'liar_freq'),
          v.names=c('belief'),
          idvar='sub_id')%>%
  dplyr::group_by(belief_type, treat_pool)%>%
  dplyr::summarise(average_belief=mean(belief,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief,na.rm=T)/sqrt(n-1))

temp$belief_type<-as.factor(temp$belief_type)

temp$belief_type = factor(temp$belief_type,levels(temp$belief_type)[c(3,2,1)])


temp%>%
  ggplot(aes(x=belief_type,y=average_belief,fill=treat_pool))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_belief-ci,ymax = average_belief+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=4,label=paste0(round(average_belief,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=5)+
  labs(x="\nBelief Type", y="Average Sender Beliefs", fill="Treatment")+
  theme_bw()+
  scale_x_discrete(labels=c("B(a=Red|m=non-Blue)", "B(a=Red|m=Blue)", "B(others-deceive)" ))+
  scale_y_continuous(limits = c(0,100), labels=function(x) paste0(x, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14,  family="serif"))+ 
  scale_fill_grey(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE")) 

ggsave("Figure6.pdf",width=20, height=15, units="cm")

```


* Are beliefs about the likelihood of receivers choosing RED after the message is BLUE different across treatments?

```{r warning=FALSE, message=FALSE}

kruskal.test(b_red_after_BLUE ~ treat_pool, data = df_S2)

# Appendix, Table B4

anova.b2 <- aov(b_red_after_BLUE ~ treat_pool, data = df_S2)
summary(anova.b2)
TukeyHSD(anova.b2)

```

* Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE different across treatments? (Direct lying: nonBLUE=RED; Selective: nonBLUE="The segment was more likely to be RED than BLUE"; Ignorance: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

kruskal.test(b_red_after_X ~ treat_pool, data = df_S2)


# Appendix, Table B5
anova.b3 <- aov(b_red_after_X ~ treat_pool, data = df_S2)
summary(anova.b3)
TukeyHSD(anova.b3)


```


* Are beliefs about the frequency of liars different across treatments?

```{r warning=FALSE, message=FALSE}

kruskal.test(b_liars ~ treat_pool, data = df_S2)

# Appendix, Table B6

anova.b1 <- aov(b_liars ~ treat_pool, data = df_S2)
summary(anova.b1)
TukeyHSD(anova.b1)

```

* Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE higher than after the message is truthful (BLUE)? (Direct lying: nonBLUE=RED; Selective: nonBLUE="The segment was more likely to be RED than BLUE"; Ignorance: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

# DIRECT

t.test(subset(df_S2, treat_pool=="control")$b_red_after_X, subset(df_S2, treat_pool=="control")$b_red_after_BLUE, paired = TRUE)

# IGNORANCE

t.test(subset(df_S2, treat_pool=="t_idk")$b_red_after_X, subset(df_S2, treat_pool=="t_idk")$b_red_after_BLUE, paired = TRUE)

# SELECTIVE

t.test(subset(df_S2, treat_pool=="t_ht")$b_red_after_X, subset(df_S2, treat_pool=="t_ht")$b_red_after_BLUE, paired = TRUE)

# SILENCE

t.test(subset(df_S2, treat_pool=="t_s")$b_red_after_X, subset(df_S2, treat_pool=="t_s")$b_red_after_BLUE, paired = TRUE)

```


* belief distribution by treatment and decision (Appendix, Figure B2)

```{r}
df_S2%>%
  dplyr::group_by(treat_pool, decision_code)%>%
  dplyr::summarise(mean_b_red_after_nonBLUE=mean(b_red_after_X, na.rm=T),
            mean_b_red_afterBLUE=mean(b_red_after_BLUE, na.rm=T),
            mean_b_liars=mean(b_liars, na.rm=T))

sender_names <- as_labeller(c(
  'lie'="Deceptive",
  'truth'="Truth"
))


df_S2%>%
  dplyr::select(treat_pool, decision_code, b_red_after_X, b_red_after_BLUE, b_liars, sub_id)%>%
  reshape(direction='long', 
          varying=list(c('b_red_after_X','b_red_after_BLUE', 'b_liars')), 
          timevar='belief_type',
          times=c('red_after_nonBLUE', 'red_after_BLUE', 'liar_freq'),
          v.names=c('belief'),
          idvar='sub_id')%>%
  dplyr::group_by(belief_type, treat_pool, decision_code)%>%
  dplyr::summarise(average_belief=mean(belief,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief,na.rm=T)/sqrt(n-1))%>%
  ggplot(aes(x=belief_type,y=average_belief,fill=treat_pool))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_belief-ci,ymax = average_belief+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=4,label=paste0(round(average_belief,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=4.4)+
  labs(x="\nBelief Type", y="Average Sender Beliefs", fill="Treatment")+
  theme_bw()+
  scale_x_discrete(labels=c("B(others-deceive)", "B(a=Red|m=Blue)", "B(a=Red|m=non-Blue)"))+
  scale_y_continuous(limits = c(0,100), labels=function(x) paste0(x, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14))+   scale_fill_grey(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE")) +
  facet_wrap(~decision_code, labeller=sender_names)

ggsave("FigureB2.png",width=30, height=15, units="cm")

```

* (Appendix, Table B12) Are beliefs about the likelihood of receivers choosing RED after the message is BLUE different across sender decisions?

```{r warning=FALSE, message=FALSE}

anova.b2 <- aov(b_red_after_BLUE ~ treat_pool*decision_code, data = df_S2)
summary(anova.b2)


```

* (Appendix, Table B13) Are beliefs about the likelihood of receivers choosing RED after the message is nonBLUE different across sender decision? (Direct lying: nonBLUE=RED; Selective: nonBLUE="The segment was more likely to be RED than BLUE"; Ignorance: nonBLUE="I don't know the colour of the segment"; Silence: nonBLUE=""(silence))

```{r warning=FALSE, message=FALSE}

anova.b3 <- aov(b_red_after_X ~ treat_pool*decision_code, data = df_S2)
summary(anova.b3)


```

* (Appendix, Table B14) Are beliefs about the frequency of liars different across sender decision?

```{r warning=FALSE, message=FALSE}

anova.b1 <- aov(b_liars ~ treat_pool*decision_code, data = df_S2)
summary(anova.b1)


```


# STUDY 3

## Sample characteristics
Average demographics:

```{r warning=FALSE, message=FALSE}
df_S3%>%
  dplyr::mutate(educ_high=ifelse(educ_recode=="high",1,0))%>%
  dplyr::summarise(n=n(),
            mean_age=mean(age_clean, na.rm=T),
            sd_age = sd(age_clean, na.rm=T), 
            se_age = sd_age/sqrt(n),
            female_freq=mean(female, na.rm=T),
            sd_female = sd(female, na.rm=T), 
            se_female = sd_female/sqrt(n),
            mean_high_educ=mean(educ_high, na.rm=T),
            sd_high_educ = sd(educ_high, na.rm=T), 
            se_high_educ = sd_high_educ/sqrt(n))

```

Average demographics across conditions (Table B21):

```{r warning=FALSE, message=FALSE}
df_S3%>%
  dplyr::mutate(educ_high=ifelse(educ_recode=="high",1,0))%>%
  group_by(treat_pool)%>%
  dplyr::summarise(n=n(),
            mean_age=mean(age_clean, na.rm=T),
            sd_age = sd(age_clean, na.rm=T), 
            se_age = sd_age/sqrt(n),
            female_freq=mean(female, na.rm=T),
            sd_female = sd(female, na.rm=T), 
            se_female = sd_female/sqrt(n),
            mean_high_educ=mean(educ_high, na.rm=T),
            sd_high_educ = sd(educ_high, na.rm=T), 
            se_high_educ = sd_high_educ/sqrt(n))

```

* Is the average age different across conditions? - NO:

```{r warning=FALSE, message=FALSE}

# testing using Kruskal-Wallis

kruskal.test(age_clean ~ treat_pool, data = df_S3)


```

* Is the gender distribution different across conditions? - NO

```{r warning=FALSE, message=FALSE}


tbl<-table(df_S3$treat_pool, df_S3$female)
chisq.test(tbl, correct = FALSE) 


```

* Is the education level different across conditions? - NO:

```{r warning=FALSE, message=FALSE}

tbl<-table(df_S3$treat_pool, df_S3$educ_high)
chisq.test(tbl, correct = FALSE)


```

## Preliminaries

Checking that the decision to choose RED is not different across the baseline conditions:

```{r warning=FALSE, message=FALSE}

tbl<-table(subset(df_S3,treat_pool=="control")$treat, subset(df_S3,treat_pool=="control")$decision_deceptive_m)
chisq.test(tbl) 
pairwiseNominalIndependence(tbl,
                            fisher = FALSE,
                            gtest  = FALSE,
                            chisq  = TRUE,
                            method = "fdr")
```

Results of Chi-square test suggest they are not, which means we can safely pool across these.

## Choose RED across conditions given potentially deceptive message

### Is evasive lying more convincing than direct-lying?

* Chi-square test of baseline (direct-lie) vs. "Ignorance" treatment:

```{r }
temp<-subset(df_S3, treat_pool=="control"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$choose_red_deceptive_m)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S3[1]<-chisq.test(tbl, correct=FALSE)$p.value

```

* Chi-square test of baseline (direct-lie) vs. "Selective" treatment:

```{r}

temp<-subset(df_S3, treat_pool=="control"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$choose_red_deceptive_m)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S3[2]<-chisq.test(tbl, correct=FALSE)$p.value
```

* Chi-square test of baseline (direct-lie) vs. "Silence" treatment:

```{r}

temp<-subset(df_S3, treat_pool=="control"|treat=="t_s")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$choose_red_deceptive_m)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S3[3]<-chisq.test(tbl, correct=FALSE)$p.value

```

* multiple comparison adjustment:

```{r FDR}

p_main_S3
p.adjust(p_main_S3, method = 'fdr', n = length(p_main_S3))

```

## Compute effect sizes

* Direct vs. Ignorance

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(choose_red_deceptive_m ~ treat_pool, data = subset(df_S3, treat_pool=="control"|treat=="t_idk"))
res.ftest

temp<- subset(df_S3, treat_pool=="control"|treat=="t_idk")

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool, data = temp, var.equal = TRUE)

```

* Direct vs. Selective

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(choose_red_deceptive_m ~ treat_pool, data = subset(df_S3, treat_pool=="control"|treat=="t_ht"))
res.ftest

temp<- subset(df_S3, treat_pool=="control"|treat=="t_ht")

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool, data = temp, var.equal = TRUE)

```

* Direct vs. Silence

```{r}
# Test if variances different (non-signif. means can treat as equal)
res.ftest <- var.test(choose_red_deceptive_m ~ treat_pool, data = subset(df_S3, treat_pool=="control"|treat=="t_s"))
res.ftest

temp<- subset(df_S3, treat_pool=="control"|treat=="t_s")

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool, data = temp, var.equal = TRUE)


```

* Chi-square test of baseline (direct-lie) vs. all evasion treatments:

```{r }
tbl<-table(df_S3$treat_pool_bin, df_S3$choose_red_deceptive_m)
tbl
chisq.test(tbl) 

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool_bin, data = df_S3, var.equal = TRUE)

```

### Plot (Figure 7)

```{r}
ds<-df_S3 %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_red = mean(choose_red_deceptive_m), n = n(), 
            sd = sd(choose_red_deceptive_m), se = sd/sqrt(n))%>%
  mutate(condition=ifelse(treat_pool=="control",1,ifelse(treat_pool=="t_idk",2,ifelse(treat_pool=="t_s",3,4))))

ggplot(ds, aes(x=avg_red,y=treat_pool)) +
  geom_point(size=3)+ 
  geom_errorbarh(aes(xmin=avg_red-se, xmax=avg_red+se), height=.1, size=1)+
  theme_bw()+ 
  #scale_color_grey() +
  geom_text(aes(label=round(avg_red, digits=2)), vjust=-1, size=6) +
  scale_y_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+
  theme(text=element_text( family="serif"),
        legend.position = "none", 
        axis.text=element_text(size=14,face="bold"), axis.title=element_text(size=16,face="bold"), 
        plot.title=element_text(size=18,face="bold", hjust=0.5))+
  labs(y=c("Treatment\n"), x=c("\nPersuasion rate"))+
  xlim(0.25, 1) + 
  geom_segment(aes(x = 0.4, y = 1, xend = 0.4, yend = 2), color="black", size=0.5)+
  geom_segment(aes(x = 0.35, y = 1, xend = 0.35, yend = 3), color="black", size=0.5)+
  geom_segment(aes(x = 0.3, y = 1, xend = 0.3, yend = 4), color="black", size=0.5) +
  annotate(geom = "text", x = 0.385, y = 1.5, label = "***", color = "black", angle = 90, size=6)+
  annotate(geom = "text", x = 0.335, y = 2, label = "***", color = "black", angle = 90, size=6)+
  annotate(geom = "text", x = 0.285, y = 2.5, label = "***", color = "black", angle = 90, size=6)



ggsave("Figure7.pdf",width=20, height=15, units="cm")
```

### Are there differences between the different evasive statements?

* Chi-square test of "Ignorance" vs. "Selective":

```{r }
temp<-subset(df_S3, treat=="t_ht"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$choose_red_deceptive_m)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S3_ev[1]<-chisq.test(tbl, correct=FALSE)$p.value

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool, data = temp, var.equal = TRUE)


```

* Chi-square test of "Silence" vs. "Ignorance":

```{r }
temp<-subset(df_S3, treat=="t_s"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$choose_red_deceptive_m)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S3_ev[2]<-chisq.test(tbl, correct=FALSE)$p.value

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool, data = temp, var.equal = TRUE)


```

* Chi-square test of "Silence" vs. "Selective":

```{r }
temp<-subset(df_S3, treat=="t_s"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
tbl<-table(temp$treat_pool, temp$choose_red_deceptive_m)
tbl
chisq.test(tbl, correct = FALSE) 

#store p-value
p_main_S3_ev[3]<-chisq.test(tbl, correct=FALSE)$p.value

# Effect size
cohens_d(choose_red_deceptive_m ~ treat_pool, data = temp, var.equal = TRUE)


```


```{r FDR}

p_main_S3_ev
p.adjust(p_main_S3_ev, method = 'fdr', n = length(p_main_S3_ev))

```


### Probit regression (Table 5)


```{r}

# direct vs all evasions individually (Table 5, column 1)

probit_S3_ctrl <- glm(choose_red_deceptive_m ~ treat_pool +b_R_guess_red_after_deceptive + b_S_deceptive + female +age_clean + educ_high, data=df_S3, family=binomial(link="probit"))

probit_S3_ctrl_mfx <- probitmfx(choose_red_deceptive_m ~ treat_pool +b_R_guess_red_after_deceptive + b_S_deceptive + female +age_clean + educ_high, data=df_S3)
probit_S3_ctrl_mfx

# fdr adjusted p-values

p.probit_S3_ctrl_mfx<-parameters::p_value(probit_S3_ctrl_mfx)$p
p.probit_S3_ctrl_mfx.adjusted<-stats::p.adjust(p.probit_S3_ctrl_mfx, method="fdr")
p.probit_S3_ctrl_mfx.adjusted


# direct vs all evasions pooled (Table 5, column 2)


probit_S3_pooled_b <- glm(choose_red_deceptive_m ~ treat_pool_bin +b_R_guess_red_after_deceptive + b_S_deceptive + female +age_clean + educ_high, data=df_S3, family=binomial(link="probit"))

probit_S3_pooled_b_mfx <- probitmfx(choose_red_deceptive_m ~ treat_pool_bin  +b_R_guess_red_after_deceptive + b_S_deceptive + female +age_clean + educ_high, data=df_S3)
probit_S3_pooled_b_mfx

# fdr adjusted p-values

p.probit_S3_pooled_b_mfx<-parameters::p_value(probit_S3_pooled_b_mfx)$p
p.probit_S3_pooled_b_mfx.adjusted<-stats::p.adjust(p.probit_S3_pooled_b_mfx, method="fdr")
p.probit_S3_pooled_b_mfx.adjusted


# test for differences in the coefficients of the evasion treatments

## Ignorance vs Selective

linearHypothesis(probit_S3_ctrl,
                 c("treat_poolt_idk=treat_poolt_ht"), 
                 test=c("Chisq"), 
                 white.adjust=TRUE)

## Ignorance vs Silence

linearHypothesis(probit_S3_ctrl, 
                 c("treat_poolt_idk=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)

## Selective vs Silence

linearHypothesis(probit_S3_ctrl, 
                 c("treat_poolt_ht=treat_poolt_s"),
                 test=c("Chisq"), 
                 white.adjust=TRUE)


# regressions without controlling for any beliefs

## Appendix, Table B29, Column 1

probit_S3_ctrl_no_b_mfx <- probitmfx(choose_red_deceptive_m ~ treat_pool + female +age_clean + educ_high, data=df_S3)

probit_S3_ctrl_no_b_mfx

## Appendix, Table B29, Column 2

probit_S3_bin_ctrl_no_b_mfx <- probitmfx(choose_red_deceptive_m ~ treat_pool_bin + female +age_clean + educ_high, data=df_S3)

probit_S3_bin_ctrl_no_b_mfx



```


## Beliefs analysis

### Average beliefs by treatment

* Figure 8

```{r}
df_S3%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::summarise(mean_b_S_deceptive=mean(b_S_deceptive, na.rm=T),
            mean_b_red_afterDeceptive=mean(b_R_guess_red_after_deceptive, na.rm=T))

temp<-df_S3%>%
  dplyr::select(treat_pool, b_S_deceptive, b_R_guess_red_after_deceptive, sub_id)%>%
  reshape(direction='long', 
          varying=list(c('b_S_deceptive','b_R_guess_red_after_deceptive')), 
          timevar='belief_type',
          times=c('S_deceptive', 'R_guess_red_after_deceptive'),
          v.names=c('belief'),
          idvar='sub_id')%>%
  dplyr::group_by(belief_type, treat_pool)%>%
  dplyr::summarise(average_belief=mean(belief,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief,na.rm=T)/sqrt(n-1))

temp$belief_type<-as.factor(temp$belief_type)

temp$belief_type = factor(temp$belief_type,levels(temp$belief_type)[c(2,1)])

temp%>%
  ggplot(aes(x=belief_type,y=average_belief,fill=treat_pool))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_belief-ci,ymax = average_belief+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=4,label=paste0(round(average_belief,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=5)+
  labs(x="\nBelief Type", y="Average Receiver Beliefs", fill="Treatment")+
  theme_bw()+
  scale_x_discrete(labels=c("B(S-deceives)", "B(a=Red|m=non-Blue)"))+
  scale_y_continuous(limits = c(0,100), labels=function(x) paste0(x, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14,  family="serif"))+ 
  scale_fill_grey(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE")) 

ggsave("Figure8.pdf",width=20, height=15, units="cm")

```

#### tests

* Are beliefs about how likely senders were to deceive different across treatments?

```{r }

kruskal.test(b_S_deceptive ~ treat_pool, data = df_S3)


# Appendix, Table B7
anova.b3 <- aov(b_S_deceptive ~ treat_pool, data = df_S3)
summary(anova.b3)
TukeyHSD(anova.b3)

```

* Are beliefs about how likely receivers are to choose RED after potentially deceptive message different across treatments?


```{r }

kruskal.test(b_R_guess_red_after_deceptive ~ treat_pool, data = df_S3)


# Appendix, Table B8

anova.b1 <- aov(b_R_guess_red_after_deceptive ~ treat_pool, data = df_S3)
summary(anova.b1)
TukeyHSD(anova.b1)

```


### Check - beliefs in line with actions?

```{r warning=FALSE, message=FALSE}

df_S3<-df_S3%>%
  mutate(belief_action=ifelse(treat_pool=="control" & b_S_deceptive<=(2/3)*100, 1,
                              ifelse(treat_pool!="control" & b_S_deceptive<=(1/2)*100,1,0)),
              belief_consistent=ifelse(choose_red_deceptive_m==belief_action,1,0))

df_S3%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::summarise(total_count=n(),
                   group_count=sum(belief_consistent),
                   average_consistent=mean(belief_consistent,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief_consistent,na.rm=T)/sqrt(n-1))

df_S3%>%
  dplyr::group_by(treat_pool, belief_action)%>%
  dplyr::summarise(total_count=n(),
                   group_count=sum(belief_consistent),
                   average_consistent=mean(belief_consistent,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief_consistent,na.rm=T)/sqrt(n-1))%>%
  ggplot(aes(x=treat_pool,y=average_consistent,fill=as.factor(belief_action)))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_consistent-ci,ymax = average_consistent+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=0.1,label=paste0(round(average_consistent*100,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=5)+
  geom_text(aes(y=0.03,label=paste0("(",group_count,"/",total_count,")")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=4)+
  labs(x="Treatment", y="Average Consistency Beliefs-Actions", fill="Belief-predicted action")+
  theme_bw()+
 scale_x_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+
  scale_y_continuous(limits = c(0,1), labels=function(x) paste0(x*100, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14,  family="serif"))+ 
  scale_fill_grey(labels=c("Blue", "Red" ))


ggsave("Figure9.pdf", width=20, height=15, units="cm")



```


* Chi-square test of consistency rate between chosen actions - DIRECT:

```{r}

temp<-subset(df_S3, treat_pool=="control")
#drop unused levels
temp <- droplevels(temp)


tbl<-table(temp$belief_action, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)



```


* Chi-square test of consistency rate between chosen actions - SELECTIVE:

```{r}

temp<-subset(df_S3, treat_pool=="t_ht")
#drop unused levels
temp <- droplevels(temp)


tbl<-table(temp$belief_action, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)



```


* Chi-square test of consistency rate between chosen actions - IGNORANCE:

```{r}

temp<-subset(df_S3, treat_pool=="t_idk")
#drop unused levels
temp <- droplevels(temp)


tbl<-table(temp$belief_action, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)



```

* Chi-square test of consistency rate between chosen actions - SILENCE:

```{r}

temp<-subset(df_S3, treat_pool=="t_s")
#drop unused levels
temp <- droplevels(temp)


tbl<-table(temp$belief_action, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)


```


#### Figure B3

```{r}
df_S3%>%
  dplyr::group_by(treat_pool, decision_deceptive_m)%>%
  dplyr::summarise(mean_b_S_deceptive=mean(b_S_deceptive, na.rm=T),
            mean_b_red_afterDeceptive=mean(b_R_guess_red_after_deceptive, na.rm=T))



df_S3%>%
  dplyr::select(treat_pool, decision_deceptive_m, b_S_deceptive, b_R_guess_red_after_deceptive, sub_id)%>%
  reshape(direction='long', 
          varying=list(c('b_S_deceptive','b_R_guess_red_after_deceptive')), 
          timevar='belief_type',
          times=c('S_deceptive', 'R_guess_red_after_deceptive'),
          v.names=c('belief'),
          idvar='sub_id')%>%
  dplyr::group_by(belief_type, treat_pool,decision_deceptive_m)%>%
  dplyr::summarise(average_belief=mean(belief,na.rm=T),n=n(),ci=qnorm(0.975)*sd(belief,na.rm=T)/sqrt(n-1))%>%
  ggplot(aes(x=belief_type,y=average_belief,fill=treat_pool))+
  geom_bar(position="dodge", stat="identity")+
    geom_errorbar(aes(ymin = average_belief-ci,ymax = average_belief+ci),
                         width = 0.2,position=position_dodge(0.9))+
  geom_text(aes(y=4,label=paste0(round(average_belief,0), "%")),
            position=position_dodge(width=0.9),color="white",
            lineheight = 0.75, size=5)+
  labs(x="\nBelief Type", y="Average Receiver Beliefs", fill="Treatment")+
  theme_bw()+
  scale_x_discrete(labels=c("B(a=Red|m=non-Blue)", "B(S-deceives)"))+
  scale_y_continuous(limits = c(0,100), labels=function(x) paste0(x, "%"))+
  theme(legend.position = "bottom", text=element_text(size=14,  family="serif"))+ 
  scale_fill_grey(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+
  facet_wrap(~decision_deceptive_m)

ggsave("FigureB3",width=30, height=15, units="cm")

```

#### Tests of differences in beliefs across treatments and receiver decision

```{r warning=FALSE, message=FALSE}

# Appendix, Table B15

anova.b1 <- aov(b_S_deceptive ~ treat_pool*decision_deceptive_m, data = df_S3)
summary(anova.b1)

# Appendix, Table B16

anova.b2 <- aov(b_R_guess_red_after_deceptive ~ treat_pool*decision_deceptive_m, data = df_S3)
summary(anova.b2)


```



#### Tests for comparisons in Table B17 in Appendix

* Chi-square test of baseline (direct-lie) vs. "Ignorance" treatment:

```{r }
temp<-subset(df_S3, treat_pool=="control"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
mean(subset(temp, treat_pool=="control")$belief_consistent) - mean(subset(temp, treat_pool=="t_idk")$belief_consistent)


tbl<-table(temp$treat_pool, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 

sum(tbl)
```

* Chi-square test of baseline (direct-lie) vs. "Selective" treatment:

```{r}

temp<-subset(df_S3, treat_pool=="control"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
mean(subset(temp, treat_pool=="control")$belief_consistent) - mean(subset(temp, treat_pool=="t_ht")$belief_consistent)

tbl<-table(temp$treat_pool, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)

```

* Chi-square test of baseline (direct-lie) vs. "Silence" treatment:

```{r}

temp<-subset(df_S3, treat_pool=="control"|treat=="t_s")
#drop unused levels
temp <- droplevels(temp)
mean(subset(temp, treat_pool=="control")$belief_consistent) - mean(subset(temp, treat_pool=="t_s")$belief_consistent)

tbl<-table(temp$treat_pool, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)

```

* Chi-square test of "Half truth" vs. "Ignorance" treatment:

```{r }
temp<-subset(df_S3, treat_pool=="t_ht"|treat=="t_idk")
#drop unused levels
temp <- droplevels(temp)
mean(subset(temp, treat_pool=="t_ht")$belief_consistent) - mean(subset(temp, treat_pool=="t_idk")$belief_consistent)

tbl<-table(temp$treat_pool, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)
```


* Chi-square test of "Silence" vs. "Ignorance" treatment:

```{r}

temp<-subset(df_S3, treat_pool=="t_idk"|treat=="t_s")
#drop unused levels
temp <- droplevels(temp)
mean(subset(temp, treat_pool=="t_s")$belief_consistent) - mean(subset(temp, treat_pool=="t_idk")$belief_consistent)

tbl<-table(temp$treat_pool, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)

```

* Chi-square test of "Silence" vs. "Selective" treatment:

```{r}

temp<-subset(df_S3, treat_pool=="t_s"|treat=="t_ht")
#drop unused levels
temp <- droplevels(temp)
mean(subset(temp, treat_pool=="t_s")$belief_consistent) - mean(subset(temp, treat_pool=="t_ht")$belief_consistent)

tbl<-table(temp$treat_pool, temp$belief_consistent)
tbl
chisq.test(tbl, correct = FALSE) 
sum(tbl)
```



# Appendix: Welfare analysis

## Simulating payoffs

```{r}
set.seed(0); 

df_S1$Spinner_Outcome<-as.numeric(df_S1$Spinner_Outcome)
df_S1$X<-as.numeric(df_S1$X)
df_S1$Z<-as.numeric(df_S1$Z)
df_S2$Spinner_Outcome<-as.numeric(df_S2$Spinner_Outcome)
df_S2$X<-as.numeric(df_S2$X)
df_S2$Z<-as.numeric(df_S2$Z)
df_S3$X<-as.numeric(df_S3$X)
df_S3$Z<-as.numeric(df_S3$Z)


df_S1_thin<-df_S1%>%
  dplyr::select(Prolific_id, sub_id, treat, treat_pool, decision, decision_code, Spinner_Outcome)%>%
  dplyr::mutate(message_sent=ifelse(Spinner_Outcome<=6, "Red",
                             ifelse(Spinner_Outcome>=15, "Ambiguous", 
                                    ifelse (Spinner_Outcome>6 & Spinner_Outcome<15 &  treat_pool=="control" & decision_code=="lie", "Red",
                                            ifelse(Spinner_Outcome>6 & Spinner_Outcome<15 &  treat_pool!="control" & decision_code=="lie","Ambiguous","Blue")))),
         message_truth=ifelse(Spinner_Outcome<=6, "Red",
                             ifelse(Spinner_Outcome>=15, "Ambiguous", "Blue")),
         segment_color=ifelse( (Spinner_Outcome>6 & Spinner_Outcome<15) | Spinner_Outcome==20, "BLUE", "RED"),
         role="sender")%>%
  dplyr::group_by(treat_pool)%>%
  dplyr::mutate(match_id_start=row_number())


df_S3_thin<-df_S3%>%
  dplyr::select(Prolific_id, sub_id, treat, treat_pool, decision_deceptive_m,
                decision_nondeceptive_m, decision_blue_m)%>%
  dplyr::mutate(role="receiver")



df_S1_thin2<-df_S1_thin%>%
  dplyr::select(-Prolific_id, -sub_id, -treat, -role)

receiver_pay_sim<-as.data.frame(matrix(nrow=nrow(df_S3_thin), ncol=8))

receiver_pay_sim[,1]<-df_S3_thin$Prolific_id
colnames(receiver_pay_sim)[1]<-"Prolific_id"
receiver_pay_sim[,2]<-df_S3_thin$sub_id
colnames(receiver_pay_sim)[2]<-"sub_id"
receiver_pay_sim[,3]<-df_S3_thin$treat
colnames(receiver_pay_sim)[3]<-"treat"
receiver_pay_sim[,4]<-df_S3_thin$treat_pool
colnames(receiver_pay_sim)[4]<-"treat_pool"
colnames(receiver_pay_sim)[5]<-"Spinner_Outcome"
colnames(receiver_pay_sim)[6]<-"message"


sender_pay_sim<-as.data.frame(matrix(nrow=nrow(df_S1_thin), ncol=7))

sender_pay_sim[,1]<-df_S1_thin$Prolific_id
colnames(sender_pay_sim)[1]<-"Prolific_id"
sender_pay_sim[,2]<-df_S1_thin$sub_id
colnames(sender_pay_sim)[2]<-"sub_id"
sender_pay_sim[,3]<-df_S1_thin$treat
colnames(sender_pay_sim)[3]<-"treat"
sender_pay_sim[,4]<-df_S1_thin$treat_pool
colnames(sender_pay_sim)[4]<-"treat_pool"
sender_pay_sim[,5]<-df_S1_thin$match_id_start
colnames(sender_pay_sim)[5]<-"match_id_start"
colnames(sender_pay_sim)[6]<-"Spinner_Outcome"
colnames(sender_pay_sim)[7]<-"message"

receiver_pay_sim_gullible<-as.data.frame(matrix(nrow=nrow(df_S3_thin), ncol=306))

receiver_pay_sim_gullible[,1]<-df_S3_thin$Prolific_id
colnames(receiver_pay_sim_gullible)[1]<-"Prolific_id"
receiver_pay_sim_gullible[,2]<-df_S3_thin$sub_id
colnames(receiver_pay_sim_gullible)[2]<-"sub_id"
receiver_pay_sim_gullible[,3]<-df_S3_thin$treat
colnames(receiver_pay_sim_gullible)[3]<-"treat"
receiver_pay_sim_gullible[,4]<-df_S3_thin$treat_pool
colnames(receiver_pay_sim_gullible)[4]<-"treat_pool"
colnames(receiver_pay_sim_gullible)[5]<-"Spinner_Outcome"
colnames(receiver_pay_sim_gullible)[6]<-"message"


sender_pay_sim_gullible<-as.data.frame(matrix(nrow=nrow(df_S1_thin), ncol=7))

sender_pay_sim_gullible[,1]<-df_S1_thin$Prolific_id
colnames(sender_pay_sim_gullible)[1]<-"Prolific_id"
sender_pay_sim_gullible[,2]<-df_S1_thin$sub_id
colnames(sender_pay_sim_gullible)[2]<-"sub_id"
sender_pay_sim_gullible[,3]<-df_S1_thin$treat
colnames(sender_pay_sim_gullible)[3]<-"treat"
sender_pay_sim_gullible[,4]<-df_S1_thin$treat_pool
colnames(sender_pay_sim_gullible)[4]<-"treat_pool"
sender_pay_sim_gullible[,5]<-df_S1_thin$match_id_start
colnames(sender_pay_sim_gullible)[5]<-"match_id_start"
colnames(sender_pay_sim_gullible)[6]<-"Spinner_Outcome"
colnames(sender_pay_sim_gullible)[7]<-"message"

receiver_pay_sim_random<-as.data.frame(matrix(nrow=nrow(df_S3_thin), ncol=306))

receiver_pay_sim_random[,1]<-df_S3_thin$Prolific_id
colnames(receiver_pay_sim_random)[1]<-"Prolific_id"
receiver_pay_sim_random[,2]<-df_S3_thin$sub_id
colnames(receiver_pay_sim_random)[2]<-"sub_id"
receiver_pay_sim_random[,3]<-df_S3_thin$treat
colnames(receiver_pay_sim_random)[3]<-"treat"
receiver_pay_sim_random[,4]<-df_S3_thin$treat_pool
colnames(receiver_pay_sim_random)[4]<-"treat_pool"
colnames(receiver_pay_sim_random)[5]<-"Spinner_Outcome"
colnames(receiver_pay_sim_random)[6]<-"message"


sender_pay_sim_random<-as.data.frame(matrix(nrow=nrow(df_S1_thin), ncol=7))

sender_pay_sim_random[,1]<-df_S1_thin$Prolific_id
colnames(sender_pay_sim_random)[1]<-"Prolific_id"
sender_pay_sim_random[,2]<-df_S1_thin$sub_id
colnames(sender_pay_sim_random)[2]<-"sub_id"
sender_pay_sim_random[,3]<-df_S1_thin$treat
colnames(sender_pay_sim_random)[3]<-"treat"
sender_pay_sim_random[,4]<-df_S1_thin$treat_pool
colnames(sender_pay_sim_random)[4]<-"treat_pool"
sender_pay_sim_random[,5]<-df_S1_thin$match_id_start
colnames(sender_pay_sim_random)[5]<-"match_id_start"
colnames(sender_pay_sim_random)[6]<-"Spinner_Outcome"
colnames(sender_pay_sim_random)[7]<-"message"

receiver_pay_sim_truth<-as.data.frame(matrix(nrow=nrow(df_S3_thin), ncol=306))

receiver_pay_sim_truth[,1]<-df_S3_thin$Prolific_id
colnames(receiver_pay_sim_truth)[1]<-"Prolific_id"
receiver_pay_sim_truth[,2]<-df_S3_thin$sub_id
colnames(receiver_pay_sim_truth)[2]<-"sub_id"
receiver_pay_sim_truth[,3]<-df_S3_thin$treat
colnames(receiver_pay_sim_truth)[3]<-"treat"
receiver_pay_sim_truth[,4]<-df_S3_thin$treat_pool
colnames(receiver_pay_sim_truth)[4]<-"treat_pool"
colnames(receiver_pay_sim_truth)[5]<-"Spinner_Outcome"
colnames(receiver_pay_sim_truth)[6]<-"message"


sender_pay_sim_truth<-as.data.frame(matrix(nrow=nrow(df_S1_thin), ncol=7))

sender_pay_sim_truth[,1]<-df_S1_thin$Prolific_id
colnames(sender_pay_sim_truth)[1]<-"Prolific_id"
sender_pay_sim_truth[,2]<-df_S1_thin$sub_id
colnames(sender_pay_sim_truth)[2]<-"sub_id"
sender_pay_sim_truth[,3]<-df_S1_thin$treat
colnames(sender_pay_sim_truth)[3]<-"treat"
sender_pay_sim_truth[,4]<-df_S1_thin$treat_pool
colnames(sender_pay_sim_truth)[4]<-"treat_pool"
sender_pay_sim_truth[,5]<-df_S1_thin$match_id_start
colnames(sender_pay_sim_truth)[5]<-"match_id_start"
colnames(sender_pay_sim_truth)[6]<-"Spinner_Outcome"
colnames(sender_pay_sim_truth)[7]<-"message"



receiver_pay_sim_lie<-as.data.frame(matrix(nrow=nrow(df_S3_thin), ncol=306))

receiver_pay_sim_lie[,1]<-df_S3_thin$Prolific_id
colnames(receiver_pay_sim_lie)[1]<-"Prolific_id"
receiver_pay_sim_lie[,2]<-df_S3_thin$sub_id
colnames(receiver_pay_sim_lie)[2]<-"sub_id"
receiver_pay_sim_lie[,3]<-df_S3_thin$treat
colnames(receiver_pay_sim_lie)[3]<-"treat"
receiver_pay_sim_lie[,4]<-df_S3_thin$treat_pool
colnames(receiver_pay_sim_lie)[4]<-"treat_pool"
colnames(receiver_pay_sim_lie)[5]<-"Spinner_Outcome"
colnames(receiver_pay_sim_lie)[6]<-"message"


sender_pay_sim_lie<-as.data.frame(matrix(nrow=nrow(df_S1_thin), ncol=7))

sender_pay_sim_lie[,1]<-df_S1_thin$Prolific_id
colnames(sender_pay_sim_lie)[1]<-"Prolific_id"
sender_pay_sim_lie[,2]<-df_S1_thin$sub_id
colnames(sender_pay_sim_lie)[2]<-"sub_id"
sender_pay_sim_lie[,3]<-df_S1_thin$treat
colnames(sender_pay_sim_lie)[3]<-"treat"
sender_pay_sim_lie[,4]<-df_S1_thin$treat_pool
colnames(sender_pay_sim_lie)[4]<-"treat_pool"
sender_pay_sim_lie[,5]<-df_S1_thin$match_id_start
colnames(sender_pay_sim_lie)[5]<-"match_id_start"
colnames(sender_pay_sim_lie)[6]<-"Spinner_Outcome"
colnames(sender_pay_sim_lie)[7]<-"message"



for(i in 1:300){
df_S3_thin2<-df_S3_thin%>%
  group_by(treat_pool)%>%
  dplyr::mutate(match_id_start=sample(1:n(), replace=FALSE))%>%
  left_join(df_S1_thin2, by=c("treat_pool", "match_id_start"))%>%
  dplyr::mutate(sender_lie_message=ifelse(treat_pool=="control","Red","Ambiguous"))%>%
  dplyr::mutate(receiver_final_d_lie=ifelse(sender_lie_message=="Red"&
                                   treat_pool=="control", decision_deceptive_m,
                                 ifelse(message_sent=="Ambiguous"&
                                          treat_pool=="control", decision_nondeceptive_m,
                                             ifelse(message_sent=="Red"&
                                                        treat_pool!="control", decision_nondeceptive_m,
                                                      ifelse(sender_lie_message=="Ambiguous", decision_deceptive_m, decision_blue_m)))))%>%
  dplyr::mutate(receiver_final_d=ifelse(message_sent=="Red"&
                                   treat_pool=="control", decision_deceptive_m,
                                 ifelse(message_sent=="Ambiguous"&
                                          treat_pool=="control", decision_nondeceptive_m,
                                             ifelse(message_sent=="Red"&
                                                        treat_pool!="control", decision_nondeceptive_m,
                                                      ifelse(message_sent=="Ambiguous", decision_deceptive_m, decision_blue_m)))),
                receiver_final_d_gullible=ifelse(message_sent=="Red"&
                                   treat_pool=="control", "RED",
                                 ifelse(message_sent=="Ambiguous"&
                                          treat_pool=="control", "RED",
                                             ifelse(message_sent=="Red"&
                                                        treat_pool!="control", "RED",
                                                      ifelse(message_sent=="Ambiguous", "RED", "BLUE")))),
                receiver_final_d_prob_match=sample(c(1:20),1, replace = TRUE),
                receiver_final_d_random=ifelse(receiver_final_d_prob_match<=11, "RED", "BLUE"),
                receiver_final_d_truth=ifelse(message_truth=="Red"&
                                   treat_pool=="control", decision_deceptive_m,
                                 ifelse(message_truth=="Ambiguous"&
                                          treat_pool=="control", decision_nondeceptive_m,
                                             ifelse(message_truth=="Red"&
                                                        treat_pool!="control", decision_nondeceptive_m,
                                                      ifelse(message_truth=="Ambiguous", decision_deceptive_m, decision_blue_m)))))%>%
  dplyr::mutate(receiver_pay=ifelse(receiver_final_d==segment_color,1,0),
         receiver_pay_gullible=ifelse(receiver_final_d_gullible==segment_color,1,0),
         receiver_pay_random=ifelse(receiver_final_d_random==segment_color,1,0),
         receiver_pay_truth=ifelse(receiver_final_d_truth==segment_color,1,0),
         receiver_pay_lie=ifelse(receiver_final_d_lie==segment_color,1,0),
         sender_pay=ifelse(receiver_final_d=="RED",1,0),
         sender_pay_gullible=ifelse(receiver_final_d_gullible=="RED",1,0),
         sender_pay_random=ifelse(receiver_final_d_random=="RED",1,0),
         sender_pay_truth=ifelse(receiver_final_d_truth=="RED",1,0),
         sender_pay_lie=ifelse(receiver_final_d_lie=="RED",1,0),
         iteration=i)%>%
  ungroup()

if(i==1){df_costs_long<-df_S3_thin2}
df_costs_long<-rbind(df_costs_long, df_S3_thin2)

receiver_pay_sim[,i+6]<-df_S3_thin2$receiver_pay
receiver_pay_sim_gullible[,i+6]<-df_S3_thin2$receiver_pay_gullible
receiver_pay_sim_random[,i+6]<-df_S3_thin2$receiver_pay_random
receiver_pay_sim_truth[,i+6]<-df_S3_thin2$receiver_pay_truth
receiver_pay_sim_lie[,i+6]<-df_S3_thin2$receiver_pay_lie

temp<- df_S3_thin2%>%
  dplyr::select(treat_pool, match_id_start, sender_pay)

sender_pay_sim<-sender_pay_sim%>%
  left_join(temp, by=c("treat_pool", "match_id_start"))

colnames(sender_pay_sim)[i+7]<-paste("V",i,sep="")

temp<- df_S3_thin2%>%
  dplyr::select(treat_pool, match_id_start, sender_pay_gullible)

sender_pay_sim_gullible<-sender_pay_sim_gullible%>%
  left_join(temp, by=c("treat_pool", "match_id_start"))

colnames(sender_pay_sim_gullible)[i+7]<-paste("V",i,sep="")

temp<- df_S3_thin2%>%
  dplyr::select(treat_pool, match_id_start, sender_pay_random)

sender_pay_sim_random<-sender_pay_sim_random%>%
  left_join(temp, by=c("treat_pool", "match_id_start"))

colnames(sender_pay_sim_random)[i+7]<-paste("V",i,sep="")

temp<- df_S3_thin2%>%
  dplyr::select(treat_pool, match_id_start, sender_pay_truth)

sender_pay_sim_truth<-sender_pay_sim_truth%>%
  left_join(temp, by=c("treat_pool", "match_id_start"))

colnames(sender_pay_sim_truth)[i+7]<-paste("V",i,sep="")

temp<- df_S3_thin2%>%
  dplyr::select(treat_pool, match_id_start, sender_pay_lie)

sender_pay_sim_lie<-sender_pay_sim_lie%>%
  left_join(temp, by=c("treat_pool", "match_id_start"))

colnames(sender_pay_sim_lie)[i+7]<-paste("V",i,sep="")



}

df_costs_long<-df_costs_long%>%
  mutate(sum_pay=receiver_pay+sender_pay)

```

## Figure B4

```{r}

# Compute the average simulated payoffs for Figure B4

avg_receiver_sim_pay<-df_costs_long %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay), n = n(), 
            sd = sd(receiver_pay), se = sd/sqrt(n))%>%
  mutate(sim_type="observed")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay<-df_costs_long%>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(sender_pay, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="observed")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))


avg_receiver_sim_pay_gullible<-df_costs_long %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_gullible), n = n(), 
            sd = sd(receiver_pay_gullible), se = sd/sqrt(n))%>%
  mutate(sim_type="gullible")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_gullible<-df_costs_long %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_gullible, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_gullible, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="gullible")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_random<-df_costs_long %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_random), n = n(), 
            sd = sd(receiver_pay_random), se = sd/sqrt(n))%>%
  mutate(sim_type="random")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_random<-df_costs_long%>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_random, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_random, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="random")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_truth<-df_costs_long %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_truth), n = n(), 
            sd = sd(receiver_pay_truth), se = sd/sqrt(n))%>%
  mutate(sim_type="truth")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_truth<-df_costs_long%>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_truth, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_truth, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="truth")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_lie<-df_costs_long %>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_lie), n = n(), 
            sd = sd(receiver_pay_lie), se = sd/sqrt(n))%>%
  mutate(sim_type="lie")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_lie<-df_costs_long%>%
  dplyr::group_by(treat_pool) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_lie, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_lie, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="lie")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_all<-rbind(avg_receiver_sim_pay, avg_receiver_sim_pay_gullible,avg_receiver_sim_pay_random, avg_receiver_sim_pay_truth, avg_receiver_sim_pay_lie )

avg_receiver_sim_pay_all$sim_type <- as.factor(avg_receiver_sim_pay_all$sim_type )


avg_receiver_sim_pay_all$sim_type = factor(avg_receiver_sim_pay_all$sim_type,levels(avg_receiver_sim_pay_all$sim_type)[c(3,1,4,5,2)])

avg_sender_sim_pay_all<-rbind(avg_sender_sim_pay, avg_sender_sim_pay_gullible,avg_sender_sim_pay_random, avg_sender_sim_pay_truth, avg_sender_sim_pay_lie )

avg_sender_sim_pay_all$sim_type <- as.factor(avg_sender_sim_pay_all$sim_type )


avg_sender_sim_pay_all$sim_type = factor(avg_sender_sim_pay_all$sim_type,levels(avg_sender_sim_pay_all$sim_type)[c(3,1,4,5,2)])



####----------Figure B4 - overall----------------######

# Figure B4 - sender (left panel)

s_plot<-ggplot(avg_sender_sim_pay_all, aes(x=treat_pool, y=avg_pay, group=sim_type, color=sim_type, shape=sim_type)) + 
geom_point(size=5)+
  #geom_errorbar(aes(ymin = avg_pay-ci,ymax = avg_pay+ci),
  #                       width = 0.1)+
  labs(x="\nTreatment", y="Sender Average Payoff (normalized)", group="Simulation Type", color="Simulation Type", shape="Simulation Type")+
  theme_bw()+
  scale_x_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+ 
  scale_color_grey(labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+ 
  scale_shape_manual(values=c(8, 15, 16, 17, 18), labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+
  theme(legend.title = element_text(size=8))+
  theme(legend.text = element_text(size=10))+
 scale_y_continuous(limits = c(0.45,0.85))+
  theme(axis.text=element_text(size=12,face="bold"),
        axis.title = element_text(size=12,face="bold"))+ 
  coord_fixed(ratio=7/1)

s_plot

ggsave("FigureB4_sender.png",width=17, height=15, units="cm")

# Figure B4 - receiver (right panel)

r_plot<-ggplot(avg_receiver_sim_pay_all, aes(x=treat_pool, y=avg_pay, group=sim_type, color=sim_type, shape=sim_type)) + 
geom_point(size=5)+
  #geom_errorbar(aes(ymin = avg_pay-ci,ymax = avg_pay+ci),
  #                       width = 0.1)+
  labs(x="\nTreatment", y="Receiver Average Payoff (normalized)", group="Simulation Type", color="Simulation Type", shape="Simulation Type")+
  theme_bw()+
  scale_x_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+ 
  scale_color_grey(labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+ 
  scale_shape_manual(values=c(8, 15, 16, 17, 18), labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+
 # theme(legend.title = element_text(size=8))+
 # theme(legend.text = element_text(size=10))+
  theme(axis.text=element_text(size=12,face="bold"),
        axis.title = element_text(size=12,face="bold"))+
  ylim(0.45,0.85)+
  theme(legend.position="none")+ 
  coord_fixed(ratio=7/1)
r_plot

ggsave("FigureB4_receiver.png",width=17, height=15, units="cm")

rs_plot<-s_plot+r_plot

rs_plot

ggsave("FigureB4.png",width=31, height=18, units="cm")


```

#### t-tests for sender pay - irrespective of segment color


```{r }

df_costs_long_sender<-df_costs_long%>%
  dplyr::select(sub_id, treat_pool, role, sender_pay, sender_pay_gullible, sender_pay_random, sender_pay_truth, sender_pay_lie)%>%
  dplyr::group_by(sub_id, treat_pool)%>%
  dplyr::summarize(mean_sender_pay=mean(sender_pay),
            mean_sender_pay_gullible=mean(sender_pay_gullible),
            mean_sender_pay_random=mean(sender_pay_random),
            mean_sender_pay_truth=mean(sender_pay_truth),
            mean_sender_pay_lie=mean(sender_pay_lie))


# Table B22 - Column DIRECT

temp<-df_costs_long_sender%>%
  filter(treat_pool=="control")

t.test(temp$mean_sender_pay, temp$mean_sender_pay_random, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_gullible, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_truth, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_lie, paired = TRUE)

# Table B22 - Column IGNORANCE

temp<-df_costs_long_sender%>%
  filter(treat_pool=="t_idk")

t.test(temp$mean_sender_pay, temp$mean_sender_pay_random, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_gullible, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_truth, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_lie, paired = TRUE)

# Table B22 - Column SELECTIVE

temp<-df_costs_long_sender%>%
  filter(treat_pool=="t_ht")

t.test(temp$mean_sender_pay, temp$mean_sender_pay_random, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_gullible, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_truth, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_lie, paired = TRUE)

# Table B22 - Column SILENCE

temp<-df_costs_long_sender%>%
  filter(treat_pool=="t_s")

t.test(temp$mean_sender_pay, temp$mean_sender_pay_random, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_gullible, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_truth, paired = TRUE)
t.test(temp$mean_sender_pay, temp$mean_sender_pay_lie, paired = TRUE)


# observed behavior across treatments
## Table B24 - Column Sender

temp<-df_costs_long_sender%>%
  filter(treat_pool!="t_s" & treat_pool!="t_ht")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(treat_pool!="t_s" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(treat_pool!="t_ht" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(treat_pool!="control" & treat_pool!="t_s")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(treat_pool!="control" & treat_pool!="t_ht")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(treat_pool!="control" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)


```

#### t-tests for receiver pay - irrespective of segment color

```{r }

df_costs_long_receiver<-df_costs_long%>%
  dplyr::select(sub_id, treat_pool, role, receiver_pay, receiver_pay_gullible, receiver_pay_random, receiver_pay_truth, receiver_pay_lie)%>%
  dplyr::group_by(sub_id, treat_pool)%>%
  dplyr::summarize(mean_receiver_pay=mean(receiver_pay),
            mean_receiver_pay_gullible=mean(receiver_pay_gullible),
            mean_receiver_pay_random=mean(receiver_pay_random),
            mean_receiver_pay_truth=mean(receiver_pay_truth),
            mean_receiver_pay_lie=mean(receiver_pay_lie))


# Table B23 - Column DIRECT

temp<-df_costs_long_receiver%>%
  filter(treat_pool=="control")

t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_random, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_gullible, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_truth, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_lie, paired = TRUE)

# Table B23 - Column IGNORANCE

temp<-df_costs_long_receiver%>%
  filter(treat_pool=="t_idk")

t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_random, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_gullible, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_truth, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_lie, paired = TRUE)

# Table B23 - Column SELECTIVE

temp<-df_costs_long_receiver%>%
  filter(treat_pool=="t_ht")

t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_random, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_gullible, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_truth, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_lie, paired = TRUE)

# Table B23 - Column SILENCE

temp<-df_costs_long_receiver%>%
  filter(treat_pool=="t_s")

t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_random, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_gullible, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_truth, paired = TRUE)
t.test(temp$mean_receiver_pay, temp$mean_receiver_pay_lie, paired = TRUE)


# observed behavior across treatments
## Table B24 - Column Receiver

temp<-df_costs_long_receiver%>%
  filter(treat_pool!="t_s" & treat_pool!="t_ht")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(treat_pool!="t_s" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(treat_pool!="t_ht" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(treat_pool!="control" & treat_pool!="t_s")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(treat_pool!="control" & treat_pool!="t_ht")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(treat_pool!="control" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

```



#### t-tests for sender pay - conditional on segment color

```{r }

df_costs_long_sender<-df_costs_long%>%
  dplyr::select(sub_id, treat_pool, role, segment_color, sender_pay, sender_pay_gullible, sender_pay_random, sender_pay_truth, sender_pay_lie)%>%
  dplyr::group_by(sub_id, treat_pool, segment_color)%>%
  dplyr::summarize(mean_sender_pay=mean(sender_pay),
            mean_sender_pay_gullible=mean(sender_pay_gullible),
            mean_sender_pay_random=mean(sender_pay_random),
            mean_sender_pay_truth=mean(sender_pay_truth),
            mean_sender_pay_lie=mean(sender_pay_lie))


# observed behavior across treatments

## Conditional on segment being Blue

## Table B25 - Column Sender

temp<-df_costs_long_sender%>%
  filter(segment_color=="BLUE" & treat_pool!="t_s" & treat_pool!="t_ht")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="BLUE" & treat_pool!="t_s" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="BLUE" & treat_pool!="t_ht" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="BLUE" & treat_pool!="control" & treat_pool!="t_s")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="BLUE" & treat_pool!="control" & treat_pool!="t_ht")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="BLUE" & treat_pool!="control" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)


## Conditional on segment being Red

## Table B26 - Column Sender

temp<-df_costs_long_sender%>%
  filter(segment_color=="RED" & treat_pool!="t_s" & treat_pool!="t_ht")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="RED" & treat_pool!="t_s" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="RED" & treat_pool!="t_ht" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="RED" & treat_pool!="control" & treat_pool!="t_s")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="RED" & treat_pool!="control" & treat_pool!="t_ht")
t.test(data=temp, mean_sender_pay~treat_pool)

temp<-df_costs_long_sender%>%
  filter(segment_color=="RED" & treat_pool!="control" & treat_pool!="t_idk")
t.test(data=temp, mean_sender_pay~treat_pool)


```

#### t-tests for receiver pay - conditional on segment color

```{r }

df_costs_long_receiver<-df_costs_long%>%
  dplyr::select(sub_id, treat_pool, role, segment_color, receiver_pay, receiver_pay_gullible, receiver_pay_random, receiver_pay_truth, receiver_pay_lie)%>%
  dplyr::group_by(sub_id, treat_pool, segment_color)%>%
  dplyr::summarize(mean_receiver_pay=mean(receiver_pay),
            mean_receiver_pay_gullible=mean(receiver_pay_gullible),
            mean_receiver_pay_random=mean(receiver_pay_random),
            mean_receiver_pay_truth=mean(receiver_pay_truth),
            mean_receiver_pay_lie=mean(receiver_pay_lie))


# observed behavior across treatments

## Conditional on segment being Blue

## Table B25 - Column Receiver

temp<-df_costs_long_receiver%>%
  filter(segment_color=="BLUE" & treat_pool!="t_s" & treat_pool!="t_ht")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="BLUE" & treat_pool!="t_s" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="BLUE" & treat_pool!="t_ht" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="BLUE" & treat_pool!="control" & treat_pool!="t_s")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="BLUE" & treat_pool!="control" & treat_pool!="t_ht")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="BLUE" & treat_pool!="control" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)


## Conditional on segment being Red

## Table B26 - Column Receiver

temp<-df_costs_long_receiver%>%
  filter(segment_color=="RED" & treat_pool!="t_s" & treat_pool!="t_ht")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="RED" & treat_pool!="t_s" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="RED" & treat_pool!="t_ht" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="RED" & treat_pool!="control" & treat_pool!="t_s")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="RED" & treat_pool!="control" & treat_pool!="t_ht")
t.test(data=temp, mean_receiver_pay~treat_pool)

temp<-df_costs_long_receiver%>%
  filter(segment_color=="RED" & treat_pool!="control" & treat_pool!="t_idk")
t.test(data=temp, mean_receiver_pay~treat_pool)

```


## Figure B5

```{r}

# Compute the average simulated payoffs for Figure B5

avg_receiver_sim_pay<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay), n = n(), 
            sd = sd(receiver_pay), se = sd/sqrt(n))%>%
  mutate(sim_type="observed")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay<-df_costs_long%>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(sender_pay, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="observed")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))


avg_receiver_sim_pay_gullible<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_gullible), n = n(), 
            sd = sd(receiver_pay_gullible), se = sd/sqrt(n))%>%
  mutate(sim_type="gullible")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_gullible<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_gullible, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_gullible, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="gullible")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_random<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_random), n = n(), 
            sd = sd(receiver_pay_random), se = sd/sqrt(n))%>%
  mutate(sim_type="random")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_random<-df_costs_long%>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_random, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_random, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="random")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_truth<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_truth), n = n(), 
            sd = sd(receiver_pay_truth), se = sd/sqrt(n))%>%
  mutate(sim_type="truth")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_truth<-df_costs_long%>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_truth, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_truth, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="truth")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_lie<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(receiver_pay_lie), n = n(), 
            sd = sd(receiver_pay_lie), se = sd/sqrt(n))%>%
  mutate(sim_type="lie")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_sender_sim_pay_lie<-df_costs_long%>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(sender_pay_lie, na.rm=TRUE), n = n(), 
            sd = sd(sender_pay_lie, na.rm=TRUE), se = sd/sqrt(n))%>%
  mutate(sim_type="lie")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))


avg_both_sim_pay<-df_costs_long %>%
  dplyr::group_by(treat_pool, segment_color) %>%
  dplyr::summarize(avg_pay = mean(sum_pay), n = n(), 
            sd = sd(sum_pay), se = sd/sqrt(n))%>%
  mutate(sim_type="observed")%>%
  mutate(ci=qnorm(0.975)*sd/sqrt(n-1))

avg_receiver_sim_pay_all_by_state<-rbind(avg_receiver_sim_pay, avg_receiver_sim_pay_gullible,avg_receiver_sim_pay_random, avg_receiver_sim_pay_truth, avg_receiver_sim_pay_lie )

avg_receiver_sim_pay_all_by_state$sim_type <- as.factor(avg_receiver_sim_pay_all_by_state$sim_type )


avg_receiver_sim_pay_all_by_state$sim_type = factor(avg_receiver_sim_pay_all_by_state$sim_type,levels(avg_receiver_sim_pay_all_by_state$sim_type)[c(3,1,4,5,2)])

avg_sender_sim_pay_all_by_state<-rbind(avg_sender_sim_pay, avg_sender_sim_pay_gullible,avg_sender_sim_pay_random, avg_sender_sim_pay_truth, avg_sender_sim_pay_lie )

avg_sender_sim_pay_all_by_state$sim_type <- as.factor(avg_sender_sim_pay_all_by_state$sim_type )


avg_sender_sim_pay_all_by_state$sim_type = factor(avg_sender_sim_pay_all_by_state$sim_type,levels(avg_sender_sim_pay_all_by_state$sim_type)[c(3,1,4,5,2)])




####----------Figure B5 - by state----------------######
s_plot<-ggplot(avg_sender_sim_pay_all_by_state, aes(x=treat_pool, y=avg_pay, group=sim_type, color=sim_type, shape=sim_type)) + 
geom_point(size=5)+
  #geom_errorbar(aes(ymin = avg_pay-ci,ymax = avg_pay+ci),
  #                       width = 0.1)+
  labs(x="\nTreatment", y="Sender Average Payoff (normalized)", group="Simulation Type", color="Simulation Type", shape="Simulation Type")+
  theme_bw()+
  scale_x_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+ 
  scale_color_grey(labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+ 
  scale_shape_manual(values=c(8, 15, 16, 17, 18), labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+
  #theme(legend.title = element_text(size=8))+
  theme(legend.text = element_text(size=10))+
 scale_y_continuous(limits = c(0.1,1))+
  theme(axis.text=element_text(size=12,face="bold"),
        axis.title = element_text(size=12,face="bold"))+
  theme(legend.text = element_text(size=10))+
  theme(axis.text=element_text(size=12,face="bold"),
        axis.title = element_text(size=12,face="bold"))+
  #theme(legend.position="none")+ 
  coord_fixed(ratio=5/1)+
  facet_wrap(~segment_color)

s_plot

ggsave("FigureB5_top.png",width=32, height=18, units="cm")

r_plot<-ggplot(avg_receiver_sim_pay_all_by_state, aes(x=treat_pool, y=avg_pay, group=sim_type, color=sim_type, shape=sim_type)) + 
geom_point(size=5)+
  #geom_errorbar(aes(ymin = avg_pay-ci,ymax = avg_pay+ci),
  #                       width = 0.1)+
  labs(x="\nTreatment", y="Receiver Average Payoff (normalized)", group="Simulation Type", color="Simulation Type", shape="Simulation Type")+
  theme_bw()+
  scale_x_discrete(labels=c("DIRECT", "IGNORANCE", "SELECTIVE", "SILENCE"))+ 
  scale_color_grey(labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+ 
  scale_shape_manual(values=c(8, 15, 16, 17, 18), labels=c("Observed", "R_gullible", "R_p_match", "S_truth", "S_lie"))+
  #theme(legend.title = element_text(size=8))+
  theme(legend.text = element_text(size=10))+
  theme(axis.text=element_text(size=12,face="bold"),
        axis.title = element_text(size=12,face="bold"))+
  ylim(0.1,1)+ 
  coord_fixed(ratio=5/1)+
  facet_wrap(~segment_color)

r_plot

ggsave("FigureB5_bottom.png",width=32, height=18, units="cm")


rs_plot<-s_plot+r_plot

rs_plot

ggsave("FigureB5.png",width=28, height=18, units="cm")




```

